home *** CD-ROM | disk | FTP | other *** search
/ Aminet 4 / Aminet 4 - November 1994.iso / aminet / comm / term / vltj5867.lha / VLT / rexx / FifoBBS.rexx < prev    next >
OS/2 REXX Batch file  |  1994-03-27  |  34KB  |  1,335 lines
  1. /** FifoBBS.rexx
  2. *
  3. *   Alpha 0.4 by W.G.J. Langeveld, 30 January 1991:
  4. *   ---------------------------------------------------
  5. *
  6. *   Test of fifo-handler. A small BBS. Really small...
  7. *
  8. *   This requires VLT or VLTjr version 5.028 or later, and
  9. *   Matt Dillon's Fifo.library and fifo-handler. Please
  10. *   install these files and mount fifo: before running this.
  11. *
  12. *   Usage: FifoBBS [local | remote]
  13. *
  14. *   FifoBBS, when invoked without arguments will run a fake BBS
  15. *   in the current CLI. When invoked with the "local" argument,
  16. *   it will run with a local VLT, bypassing the serial port.
  17. *   In neither of these cases will "UPLOAD" or "DOWNLOAD" work.
  18. *   When invoked with the "remote" argument, it will run as a
  19. *   real BBS, through the serial port.
  20. *
  21. *   The BBS installs itself almost completely. All you have to
  22. *   do is assign FifoBBS: or change the BBSdevice string later on
  23. *   to the location you want. You will also need to set up VLT
  24. *   for running with its pipes on. After starting the BBS for
  25. *   for the first time, you can log on as Sysop, password
  26. *   SYSOP. It will ask you to change your password. From that
  27. *   moment on, you're in business. People can register, the
  28. *   sysop can validate them. Once on the system, type help to
  29. *   find a list of commands.
  30. *
  31. *   Alpha 0.5 by W.G.J. Langeveld, 22 January 1992:
  32. *   ---------------------------------------------------
  33. *
  34. *   Fixed a security problem.
  35. *
  36. *   Alpha 0.6 by W.G.J. Langeveld, 26 February 1994:
  37. *   ---------------------------------------------------
  38. *
  39. *   Added modem initialization so echoes etc. don't cause so much
  40. *   trouble. Also, set the modem to auto-answer.
  41. *   Here are the modem strings I use:
  42. */
  43.    modem.reset  = "ATZ"
  44.    modem.init   = "ATC1E0Q1S0=1" /* Follow CD, no echo/progress msgs, answer at 1 ring */
  45.    modem.ppp    = "+++"
  46.    modem.hangup = "ATH"
  47. /*
  48. *   This assumes a Hayes modem! Also added hangup after logoff using +++
  49. *   sequence, and ATZ upon exit.
  50. *
  51. *   Alpha 0.7 by W.G.J. Langeveld, 26 March 1994:
  52. *   ---------------------------------------------------
  53. *
  54. *   Tried adding carrier detect (See Carrier.vlt). Unfortunately,
  55. *   my modem seems to not assert CD when answering the phone, despite
  56. *   the "C1" in the modem init string. See also RunBBS.rexx.
  57. *
  58. **/
  59.    parse arg action
  60. /*
  61. *   Allow no interruptions for secure operation
  62. */
  63.    SIGNAL ON BREAK_C
  64.    SIGNAL ON BREAK_D
  65.    SIGNAL ON BREAK_E
  66.    SIGNAL ON BREAK_F
  67.    SIGNAL ON ERROR
  68.    SIGNAL ON FAILURE
  69.    SIGNAL ON HALT
  70.    SIGNAL ON SYNTAX
  71. /*
  72. *   This one is really for debugging purposes:
  73. */
  74.    SIGNAL ON NOVALUE
  75. /*
  76. *   Don't allow system requesters
  77. */
  78.    call pragma('W', 'NULL')
  79.  
  80.    Options failat 300
  81.    SignalLabel = "Start"
  82. /*
  83. *   Trick: here are all the global variables we want accessible to all
  84. *   routines. Watch the way interpret is used in the Procedure definitions
  85. */
  86.    GLOBAL = "GLOBAL SignalLabel BBSdevice BBSusers BBSlistings"
  87.    GLOBAL = GLOBAL || " BBSgeneral BBSmail BBSadmin BBSsysmsg BBSprompt"
  88.    GLOBAL = GLOBAL || " Protocols. CurrentUser."
  89. /*
  90. *   Get the support library.
  91. */
  92.    check = addlib('rexxsupport.library', 0, -30, 0)
  93. /*
  94. *   BBS definitions
  95. */
  96.    BBSdevice   = "FifoBBS:"
  97.    BBSusers    = BBSdevice"users"
  98.    BBSlistings = BBSdevice"listings"
  99.    BBSgeneral  = BBSdevice"general"
  100.    BBSmail     = BBSdevice"mail"
  101.    BBSadmin    = BBSdevice"admin"
  102.    BBSsysmsg   = BBSdevice"admin/system.msg"
  103.    BBSwelcome  = BBSdevice"admin/welcome.msg"
  104.    BBSprompt   = "FifoBBS> "
  105. /*
  106. *   Check if the sections exist, or else make them
  107. */
  108.    if ~exists(BBSdevice) then do
  109.       say "You must set up an assignment called "BBSdevice
  110.       exit 0
  111.    end
  112.    if ~exists(BBSusers)    then call Makedir(BBSusers)
  113.    if ~exists(BBSlistings) then call Makedir(BBSlistings)
  114.    if ~exists(BBSgeneral)  then call Makedir(BBSgeneral)
  115.    if ~exists(BBSmail)     then call Makedir(BBSmail)
  116.    if ~exists(BBSadmin)    then call Makedir(BBSadmin)
  117.    if ~exists(BBSsysmsg)   then address command "echo >"BBSsysmsg' "No news"'
  118. /*
  119. *   If there's no sysop account, make one
  120. */
  121.    if ~exists(BBSmail"/Sysop") then do
  122.       Tmp. = ""
  123.       Tmp.Account   = "Sysop"
  124.       Tmp.Password  = "SYSOP"
  125.       Tmp.Access    = 5
  126.       Tmp.Name      = "Sysop"
  127.       Tmp.MsgCount  = 0
  128.       Tmp.MailCount = 0
  129.       Tmp.Protocol  = 1
  130.       call SetRecord()
  131.       call Makedir(BBSmail"/Sysop")
  132.    end
  133. /*
  134. *   Transfer Protocols
  135. */
  136.    Protocols.0 = 5
  137.    Protocols.1.nam = "XMODEM"
  138.    Protocols.1.lib = "xprxmodem.library"
  139.    Protocols.1.set = "C1,K1"
  140.    Protocols.2.nam = "ZMODEM"
  141.    Protocols.2.lib = "xprzmodem.library"
  142.    Protocols.2.set = "T?,OS,B1,AN,DN,KN,SN,RN"
  143.    Protocols.3.nam = "Kermit"
  144.    Protocols.3.lib = "xprkermit.library"
  145.    Protocols.3.set = "OCY,GN,TN,P1500,B3"
  146.    Protocols.4.nam = "CIS QuickB"
  147.    Protocols.4.lib = "xprquickb.library"
  148.    Protocols.4.set = "TC,OS,B1,AN,DN,KN"
  149.    Protocols.5.nam = "ASCII"
  150.    Protocols.5.lib = "xprascii.library"
  151.    Protocols.5.set = "50"
  152. /*
  153. *   Redirect I/O to VLT's pipes
  154. *   For use as a BBS, use VLTR (remote). For local tests
  155. *   use VLTL (local).
  156. */
  157.    if action = "remote" then pip = "VLTR"
  158.    else                      pip = "VLTL"
  159. /*
  160. *   When action is not either "local" or "remote", you will run in
  161. *   the CLI (and you will see some echoes not otherwise present).
  162. */
  163.    if action ~= "" then do
  164.       call close("STDIN")
  165.       call close("STDOUT")
  166. /*
  167. *   First open fifo for read/write and assign to stdin
  168. */
  169.       if ~open("STDIN", "fifo:"pip"/rws") then do
  170.          say "Can't open read pipe"
  171.          exit 0
  172.       end
  173. /*
  174. *   Identify stdin with the "current console"
  175. */
  176.       call pragma('*', "STDIN")
  177. /*
  178. *   Open stdout to the current console for write.
  179. */
  180.       if ~open("STDOUT", '*', "W") then do
  181.          say "Can't open write pipe"
  182.          exit 0
  183.       end
  184.    end
  185.  
  186. /*
  187. *   Initialize the modem
  188. */
  189.    if action = "remote" then do
  190.       say modem.reset || '0d'x
  191. /*
  192. *   Get anything it might have typed back
  193. */
  194.       call Delay(200)
  195.       s = GetCommand("", 0)
  196. /*
  197. *   Set modem to no echo, no progress messages, and answer after one ring.
  198. */
  199.       say modem.init || '0d'x
  200. /*
  201. *   Get anything it might have typed back
  202. */
  203.       call delay(200)
  204.       s = GetCommand("", 0)
  205.    end
  206.  
  207.  
  208.    quitflag = 0
  209. /*
  210. *   Wait for <cr>. Here's where we go on severe problems.
  211. */
  212. Start:
  213. /*
  214. *   Fix the annoying RING echo problem
  215. */
  216.    do i = 1
  217.       s = GetCommand("", 0)
  218.       if s = "" then leave i
  219.    end
  220.    call delay(30)
  221. /*
  222. *   Welcome message.
  223. */
  224.    if action = "remote" then do
  225.       call writech("STDOUT", '1b'x||"[20h")     /* Set up "newline mode" */
  226.    end
  227.  
  228.    if exists(BBSwelcome) then do
  229.       address command "type "BBSwelcome
  230.    end
  231.    else do
  232.       say "+--------------------------------------------------+"
  233.       say "|  FifoBBS  -  Only authorized users are welcome!  +"
  234.       say "+--------------------------------------------------+"
  235.    end
  236. /*
  237. *   Log in. Don't let users without sufficient privilege get past here.
  238. */
  239.    CurrentUser. = ""
  240.  
  241.    call Login()
  242.  
  243.    if CurrentUser.Access > 2 then do
  244. /*
  245. *   If user is Sysop, make sure the password is changed first time
  246. */
  247.       if upper(CurrentUser.Account) = "SYSOP" then do
  248.          do while upper(CurrentUser.Password) = "SYSOP"
  249.             say "You MUST change the Sysop password now!"
  250.             call ChangePassword()
  251.          end
  252.       end
  253. /*
  254. *   System message
  255. */
  256.       if exists(BBSsysmsg) then address command "type "BBSsysmsg
  257. /*
  258. *   Unread mail
  259. */
  260.       n = GetMsgLeft(BBSmail"/"CurrentUser.Account, CurrentUser.MailCount)
  261.       if n ~= 0 then say "You have "n" unread mail message"Esses(n)
  262. /*
  263. *   Unread regular messages
  264. */
  265.       n = GetMsgLeft(BBSgeneral, CurrentUser.MsgCount)
  266.       if n ~= 0 then say "You have "n" unread general message"Esses(n)
  267. /*
  268. *   Main loop. Not too many commands yet. But you get the
  269. *   idea... Some commands are only available with level 5 clearance.
  270. */
  271.       do i = 1
  272.          s = GetCommand(BBSprompt, 1)
  273.          parse var s cmd arg1 arg2 .
  274.          cmd = upper(cmd)
  275.          select
  276.             when abbrev("DOWNLOAD", cmd, 2) then call Download(arg1)
  277.             when abbrev("ENTER",    cmd, 3) then call EnterMsg("")
  278.             when abbrev("EXIT",     cmd, 4) then do
  279.                quitflag = ExitBBS(cmd)
  280.                if quitflag = 1 then leave i
  281.             end
  282.             when abbrev("HELP",     cmd, 1) then call HelpList("")
  283.             when abbrev("LIST",     cmd, 2) then call ListFiles()
  284.             when abbrev("LOGOFF",   cmd, 2) then leave i
  285.             when abbrev("MAIL",     cmd, 2) then call DoMail()
  286.             when abbrev("PASSWORD", cmd, 3) then call ChangePassword()
  287.             when abbrev("PROTOCOL", cmd, 3) then call ChangeProtocol(arg1)
  288.             when abbrev("REGISTER", cmd, 3) then call Register(cmd)
  289.             when abbrev("READ",     cmd, 2) then call ReadMsg(arg1)
  290.             when abbrev("SHOW",     cmd, 2) then call ShowRecord(arg1)
  291.             when abbrev("SYSTEM",   cmd, 2) then call DoSystem(cmd)
  292.             when abbrev("UPLOAD",   cmd, 2) then call UpLoad(arg1)
  293.             when abbrev("USERS",    cmd, 2) then call ShowUsers()
  294.             when abbrev("VALIDATE", cmd, 1) then call Validate(cmd, arg1, arg2)
  295.             otherwise                            call HelpList(cmd)
  296.          end
  297.       end
  298. /*
  299. *   Save message and mail count
  300. */
  301.       n = CurrentUser.MsgCount
  302.       m = CurrentUser.MailCount
  303.       Tmp.Account = CurrentUser.Account
  304.       call GetRecord()
  305.       Tmp.MsgCount  = n
  306.       Tmp.MailCount = m
  307.       call SetRecord()
  308. /*
  309. *   Logout
  310. */
  311.       say CurrentUser.Name" logged off at "time()
  312.    end
  313. /*
  314. *   Hang up
  315. */
  316.    if action = "remote" then do
  317.       call writech("STDOUT", '1b'x||"[20l")   /* Terminate "newline mode" */
  318.       call delay(100)
  319.       call writech("STDOUT", modem.ppp)
  320.       call delay(100)
  321.       say modem.hangup || '0d'x
  322.    end
  323. /*
  324. *   If we're exiting, reset the modem
  325. */
  326.    if quitflag = 1 then do
  327.       if action = "remote" then do
  328.          call delay(100)
  329.          say modem.reset || '0d'x
  330.       end
  331.       exit 0
  332.    end
  333.  
  334.    interpret "SIGNAL" SignalLabel
  335.  
  336.  
  337.  
  338. /**************************************************************/
  339. /**************** Functions ***********************************/
  340. /**************************************************************/
  341.  
  342. /**
  343. *
  344. *   Change the password
  345. *
  346. **/
  347. ChangePassword: interpret "Procedure Expose" GLOBAL
  348.    Tmp.Account = CurrentUser.Account
  349.  
  350.    if GetRecord() = 1 then do
  351.       t = upper(GetCommand("Old Password: ", 0))
  352.       if t ~= Tmp.Password then do
  353.          say "Invalid Password"
  354.          return
  355.       end
  356.       t = upper(GetCommand("New Password: ", 0))
  357.       u = upper(GetCommand("Verification: ", 0))
  358.       if u ~= t then do
  359.          say "Verification doesn't match new password, aborted"
  360.          return
  361.       end
  362.       else if index(u, "|") ~= 0 then do
  363.          say "Illegal characters in password"
  364.          return
  365.       end
  366.       else do
  367.          Tmp.Password         = u
  368.          CurrentUser.Password = u
  369.          call SetRecord()
  370.       end
  371.    end
  372.    return
  373.  
  374.  
  375.  
  376. /**
  377. *
  378. *   Change the transfer protocol
  379. *
  380. **/
  381. ChangeProtocol: interpret "Procedure Expose" GLOBAL
  382.    arg s
  383.  
  384.    if s = "" then do
  385.       say "Transfer Protocol:"
  386.  
  387.       do i = 1 to Protocols.0
  388.          say i". "Protocols.i.nam
  389.       end
  390.       i = CurrentUser.Protocol + 0
  391.       say "Your current protocol is "Protocols.i.nam
  392.    end
  393.  
  394.    Tmp.Account = CurrentUser.Account
  395.  
  396.    if GetRecord() = 1 then do
  397.       do i = 1
  398.          if s = "" then t = upper(GetCommand("Enter new protocol (1 - 5): ", 1))
  399.          else           t = s
  400.  
  401.          if (t ~= 1) & (t ~= 2) & (t ~= 3) & (t ~= 4) & (t ~= 5) then do
  402.             say "A number from 1 through 5 was expected"
  403.             s = ""
  404.             iterate i
  405.          end
  406.          leave i
  407.       end
  408.  
  409.       CurrentUser.Protocol = t
  410.       if s = "" then do
  411.          if GetYesNo("Save for next time? ") = 1 then do
  412.             Tmp.Protocol = t
  413.             call SetRecord()
  414.          end
  415.       end
  416.    end
  417.    return
  418.  
  419.  
  420.  
  421. /**
  422. *
  423. *   Collect a message
  424. *
  425. **/
  426. CollectMsg: interpret "Procedure Expose" GLOBAL "msg."
  427.    arg comm
  428.  
  429.    say "Enter the message below."
  430.    say "Enter a dot as the first character on a line to exit."
  431.  
  432.    if comm = "" then do
  433.       msg.3 = "Title: " || GetCommand("Title: ", 1)
  434.       ni = 4
  435.    end
  436.    else ni = 3
  437.  
  438.    do k = 1
  439.       do n = ni
  440.          msg.n = GetCommand(">", 1)
  441.          if substr(msg.n, 1, 1) = "." then leave n
  442.       end
  443.  
  444.       do i = 1
  445.          s = upper(GetCommand("Quit, Continue, List, Post: ", 1))
  446.          if      abbrev("QUIT",     s, 1) then return 0
  447.          else if abbrev("LIST",     s, 1) then do
  448.             do j = 3 to n - 1
  449.                say msg.j
  450.             end
  451.          end
  452.          else if abbrev("POST",     s, 1) then leave k
  453.          else if abbrev("CONTINUE", s, 1) then do
  454.             ni = n
  455.             leave i
  456.          end
  457.       end
  458.    end
  459.    return n - 1
  460.  
  461.  
  462. /**
  463. *
  464. *   Copy the user's record from Tmp.
  465. *
  466. **/
  467. CopyRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  468.    CurrentUser.Account   = Tmp.Account
  469.    CurrentUser.Password  = Tmp.Password
  470.    CurrentUser.Access    = Tmp.Access
  471.    CurrentUser.Name      = Tmp.Name
  472.    CurrentUser.City      = Tmp.City
  473.    CurrentUser.Country   = Tmp.Country
  474.    CurrentUser.Telephone = Tmp.Telephone
  475.    CurrentUser.MsgCount  = Tmp.MsgCount
  476.    CurrentUser.MailCount = Tmp.MailCount
  477.    CurrentUser.Protocol  = Tmp.Protocol
  478.  
  479.    return
  480.  
  481.  
  482. /**
  483. *
  484. *   Mail subsystem. Two commands: read and enter. They use the same
  485. *   basic functions as the main system, but with different paths.
  486. *
  487. **/
  488. DoMail: interpret "Procedure Expose" GLOBAL
  489.    do i = 1
  490.       s = upper(GetCommand("Mail: ", 1))
  491.       parse var s cmd arg1 .
  492.       select
  493.          when abbrev("TO",    cmd, 2) then call EnterMail("", arg1)
  494.          when abbrev("HELP",  cmd, 1) then call HelpLMail("")
  495.          when abbrev("QUIT",  cmd, 1) then leave i
  496.          when abbrev("READ",  cmd, 2) then call ReadMail(arg1)
  497.          when abbrev("SHOW",  cmd, 2) then call ShowRecord(arg1)
  498.          when abbrev("USERS", cmd, 2) then call ShowUsers()
  499.          otherwise                         call HelpLMail(cmd)
  500.       end
  501.    end
  502.    return
  503.  
  504.  
  505.  
  506. /**
  507. *
  508. *   Download an existing file
  509. *
  510. **/
  511. DownLoad : interpret "Procedure Expose" GLOBAL
  512.    parse arg filnam
  513.  
  514.    if filnam = "" then filnam = GetCommand("File name? ", 1)
  515.    if ~exists(BBSlistings"/"filnam) then do
  516.       say "Can't find file "filnam
  517.       return
  518.    end
  519.  
  520.    say "Get ready to receive file "filnam
  521.  
  522.    proto = CurrentUser.Protocol + 0
  523.    address VLT "transfer protocol external; transfer mode image"
  524.    address VLT "xpr select "Protocols.proto.lib
  525.    address VLT "CD "BBSlistings
  526.    if Protocols.proto.set ~= "" then address VLT "xpr init "Protocols.proto.set
  527.    address VLT "file send "BBSlistings"/"filnam
  528. /*
  529. *   Switch back to XMODEM protocol so that we can't automatically start
  530. *   receiving stuff.
  531. */
  532.    address VLT "transfer protocol XMODEM"
  533.    return
  534.  
  535.  
  536.  
  537. /**
  538. *
  539. *   More or less direct access to the system
  540. *
  541. **/
  542. DoSystem: interpret "Procedure Expose" GLOBAL
  543.    parse arg s
  544.    if CurrentUser.Access < 5 then do
  545.       call HelpList(s)
  546.       return
  547.    end
  548. /*
  549. *   In case a command breaks, this is the label we want to get
  550. *   back to.
  551. */
  552. SysCall: SignalLabel = "SysCall"
  553.    do i = 1
  554.       s = GetCommand("$ ", 1)
  555.       parse var s cmd rest
  556.       cmd = upper(cmd)
  557.       if abbrev("RETURN", cmd, 3) then do
  558.          leave i
  559.       end
  560.       else if (cmd = "CD") & (rest ~= "") then do
  561.          call pragma("Directory", strip(rest))
  562.       end
  563.       else do
  564.          address command s
  565.       end
  566.    end
  567. /*
  568. *   Change the label back to what it was.
  569. */
  570.    SignalLabel = "Start"
  571.    return
  572.  
  573.  
  574.  
  575. /**
  576. *
  577. *   Enter a new mail message.
  578. *
  579. **/
  580. EnterMail: interpret "Procedure Expose" GLOBAL
  581.    parse arg comm, dest
  582.  
  583.    if dest = "" then dest = GetCommand("To: ", 1)
  584.    Tmp.Account = dest
  585.    if GetRecord() ~= 1 then do
  586.       say "No such account"
  587.       return
  588.    end
  589.  
  590.    n = CollectMsg(comm)
  591.    if n = 0 then return
  592.  
  593.    call MakeFile(comm, BBSmail"/"CurrentUser.Account, n)
  594.    if Tmp.Account ~= CurrentUser.Account then do
  595.       call MakeFile(comm, BBSmail"/"Tmp.Account, n)
  596.    end
  597.    return
  598.  
  599.  
  600.  
  601. /**
  602. *
  603. *   Enter a new message. Someone should build in an editor...
  604. *
  605. **/
  606. EnterMsg : interpret "Procedure Expose" GLOBAL
  607.    parse arg comm
  608.  
  609.    n = CollectMsg(comm)
  610.    if n = 0 then return
  611.  
  612.    call MakeFile(comm, BBSgeneral, n)
  613.    return
  614.  
  615.  
  616.  
  617. /**
  618. *
  619. *   An s or not an s
  620. *
  621. **/
  622. Esses: interpret "Procedure Expose" GLOBAL
  623.    arg n
  624.    if n > 1 then return "s"
  625.    return ""
  626.  
  627.  
  628.  
  629. /**
  630. *
  631. *   Exit the BBS program
  632. *
  633. **/
  634. ExitBBS: interpret "Procedure Expose" GLOBAL
  635.    parse arg s
  636.    if CurrentUser.Access >= 5 then return 1
  637.    else                            call HelpList(s)
  638.    return 0
  639.  
  640.  
  641.  
  642. /**
  643. *
  644. *   This gets the command from stdin. We can't use "pull"
  645. *   because it doesn't echo the way we open things (Fifo doesn't
  646. *   have a console handler) so we have to do it all ourselves (including
  647. *   echo and backspace). No command line editing yet.
  648. *   The first argument is the prompt string, the second argument
  649. *   specifies whether or not to echo what the user types.
  650. *   This routine checks for the presence of a "NO CARRIER"
  651. *   string at the end of the command line. If it is present, the
  652. *   session is aborted immediately. For this to work, you must make sure
  653. *   your modem detects carrier loss and sends this string.
  654. *
  655. **/
  656. GetCommand: interpret "Procedure Expose" GLOBAL
  657.    parse arg pr, echo
  658. /*
  659. *   Some constants
  660. */
  661.    cr = '0d'x
  662.    lf = '0a'x
  663.    bs = '08'x
  664.    crlf = cr||lf
  665.  
  666.    if pr ~= "" then call writech("STDOUT", pr)
  667.  
  668.    command = ""
  669.  
  670.    do forever
  671. /*
  672. *   Read a character from STDIN
  673. */
  674.       s = readch("STDIN", 1)
  675. /*
  676. *   If we get an EOF condition, abort this session.
  677. */
  678.       if eof("STDIN") then SIGNAL "Start"
  679. /*
  680. *   Echo the character. Watch out for backspaces.
  681. */
  682.       if echo = 1 then do
  683.          if (s ~= bs) & (s ~= lf) & (s ~= cr) then call writech("STDOUT", s)
  684.          if (s = bs)  & (length(command) > 0) then call writech("STDOUT", bs" "bs)
  685.       end
  686. /*
  687. *   We have a <cr> of <lf>. This is the end of a command line.
  688. *   Echo a line feed to STDOUT. Check if the line ends in
  689. *   NO CARRIER. If so, abort the session. Else, return the command.
  690. */
  691.       if s = cr | s = lf then do
  692.          call writech("STDOUT", lf)
  693.  
  694.          nc = index(command, "NO CARRIER")
  695.          if nc ~= 0 then do
  696.             if nc = length(command) - 9 then do
  697.                say "NO CARRIER detected, aborting session"
  698.                SIGNAL "Start"
  699.             end
  700.          end
  701.  
  702.          return command
  703.       end
  704. /*
  705. *   It's a backspace. Take off the last character of the command.
  706. */
  707.       else if s = bs then do
  708.          l = length(command)
  709.          if l > 0 then command = substr(command, 1, l - 1)
  710.       end
  711. /*
  712. *   A regular character. Add it to the command
  713. */
  714.       else command = command || s
  715.    end
  716.    return
  717.  
  718.  
  719.  
  720. /**
  721. *
  722. *   Get highest numbered message in the source directory
  723. *
  724. **/
  725. GetHighMsg: interpret "Procedure Expose" GLOBAL
  726.    parse arg source
  727.  
  728.    files = showdir(source, "FILES")
  729. /*
  730. *   Loop over the files, and get the highest unread  message number
  731. */
  732.    high = 0
  733.    do i = 1
  734.       parse var files "msg."k files
  735.       if k = "last" then iterate i
  736.       if k > high then high = k
  737.       if files = "" then leave
  738.    end
  739.    return high
  740.  
  741.  
  742.  
  743. /**
  744. *
  745. *   Get number of messages left to read.
  746. *
  747. **/
  748. GetMsgLeft: interpret "Procedure Expose" GLOBAL
  749.    parse arg source, last
  750.  
  751.    files = showdir(source, "FILES")
  752. /*
  753. *   Loop over the files, and extract number of messages left to read (n)
  754. */
  755.    n = 0
  756.    do i = 1
  757.       parse var files "msg."k files
  758.       if k = "last" then iterate i
  759.       if k > last then n = n + 1
  760.       if files = "" then leave
  761.    end
  762.    return n
  763.  
  764.  
  765.  
  766.  
  767. /**
  768. *
  769. *   Retrieve a user's record
  770. *
  771. **/
  772. GetRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  773.    succ = 0
  774.    if open("fi", BBSusers"/"Tmp.Account) then do
  775.       t = readln("fi")
  776.       if t ~= "" then do
  777.          parse var t Tmp.Password  '|' Tmp.Access   '|' ,
  778.                      Tmp.Name      '|' Tmp.Address  '|' ,
  779.                      Tmp.City      '|' Tmp.Country  '|' ,
  780.                      Tmp.Telephone '|' Tmp.MsgCount '|' ,
  781.                      Tmp.MailCount '|' Tmp.Protocol '|'
  782.          succ = 1
  783.       end
  784.       call close("fi")
  785.    end
  786.    return succ
  787.  
  788.  
  789.  
  790. /**
  791. *
  792. *   This gets a yes/no decision from stdin
  793. *   The single argument is used as the prompt.
  794. *
  795. **/
  796. GetYesNo: interpret "Procedure Expose" GLOBAL
  797.    parse arg prompt
  798.  
  799.    do i = 1
  800.       ss = upper(GetCommand(prompt" [Yes/No]: ", 1))
  801.       if      substr(ss, 1, 1) = 'Y' then return 1
  802.       else if substr(ss, 1, 1) = 'N' then return 0
  803.       else do
  804.          say "A Yes or No was expected, retry"
  805.       end
  806.    end
  807.    return
  808.  
  809.  
  810.  
  811. /**
  812. *
  813. *   List supported commands. Can be as extensive as you want.
  814. *
  815. **/
  816. HelpList: interpret "Procedure Expose" GLOBAL
  817.    parse arg s
  818.  
  819.    if s ~= "" then say "Unknown command: "s
  820.  
  821.    Say "Supported commands are: "
  822.    Say "-------------------------+-------------------------------------"
  823.    Say "DOWNLOAD [filename]      | Download a file [called filename]"
  824.    Say "ENTER                    | Enter a message"
  825.  
  826.    if CurrentUser.Access >= 5 then
  827.    Say "*EXIT                    | Exit the BBS program"
  828.  
  829.    Say "HELP                     | Display this list"
  830.    Say "LIST                     | List downloadable files"
  831.    Say "LOGOFF                   | Logoff"
  832.    Say "MAIL                     | Go to mail subsytem"
  833.    Say "PASSWORD                 | Set new password"
  834.    Say "PROTOCOL [n]             | Set new transfer protocol [to n]"
  835.    Say "READ [message]           | Read messages [starting at message]"
  836.  
  837.    if CurrentUser.Access >= 5 then
  838.    Say "*REGISTER                | Add a new user to the system"
  839.  
  840.    Say "SHOW [name]              | Show current record [of user ""name""]"
  841.  
  842.    if CurrentUser.Access >= 5 then
  843.    Say "*SYSTEM                  | Change to system command level"
  844.  
  845.    Say "UPLOAD [filename]        | Upload a file [called filename]"
  846.    Say "USERS                    | Show the user list"
  847.  
  848.    if CurrentUser.Access >= 5 then
  849.    Say "*VALIDATE [user] [level] | Validate a new user"
  850.    Say "-------------------------+-------------------------------------"
  851.    return
  852.  
  853.  
  854.  
  855. /**
  856. *
  857. *   List supported commands in mail.
  858. *
  859. **/
  860. HelpLMail: interpret "Procedure Expose" GLOBAL
  861.    parse arg s
  862.  
  863.    if s ~= "" then say "Unknown command: "s
  864.  
  865.    Say "Supported commands while in mail are: "
  866.    Say "----------------+-------------------------------------"
  867.    Say "TO              | Enter a message"
  868.    Say "HELP            | Display this list"
  869.    Say "QUIT            | Quit from the mail subsystem"
  870.    Say "READ [message]  | Read messages [starting at message]"
  871.    Say "SHOW [name]     | Show current record [of user ""name""]"
  872.    Say "USERS           | Show the user list"
  873.    Say "----------------+-------------------------------------"
  874.    return
  875.  
  876.  
  877.  
  878. /**
  879. *
  880. *   List downloadable files
  881. *
  882. **/
  883. ListFiles: interpret "Procedure Expose" GLOBAL
  884.    address command "list "BBSlistings" nohead"
  885.    return
  886.  
  887.  
  888.  
  889. /**
  890. *
  891. *   Handle logins and new registrations.
  892. *   Argument is a user account name, so we can log ourselves back in
  893. *   if we as a sysop have added someone else using Register().
  894. *
  895. **/
  896. Login: interpret "Procedure Expose" GLOBAL
  897.    Tmp.               = ""
  898.    Tmp.Access         = 0
  899.    CurrentUser.Access = 0
  900.  
  901.    do tries = 1 to 3
  902.       Tmp.Account = upper(GetCommand("Username: ", 1))
  903.       if Tmp.Account = "NEW" then do
  904.          call Register("")
  905.          return
  906.       end
  907.       else if GetRecord() = 0 then do
  908.          say "Not registered."
  909.          say "To register, use the NEW account."
  910.       end
  911.       else do
  912.          s = upper(GetCommand("Password: ", 0))
  913.          if s ~= Tmp.Password then do
  914.             if tries < 3 then  say "Error in name or password, try again..."
  915.             else               say "Error in name or password, logging of."
  916.             Tmp.Access = 0
  917.          end
  918.          else leave tries
  919.       end
  920.    end
  921.  
  922.    call CopyRecord()
  923.    if CurrentUser.Access = 2 then say "You are not yet validated"
  924.    return
  925.  
  926.  
  927.  
  928. /**
  929. *
  930. *   Make a file header, and add it in the destination directory
  931. *
  932. **/
  933. MakeFile: interpret "Procedure Expose" GLOBAL "msg."
  934.    parse arg comm, dest, nlins
  935. /*
  936. *   Get list of files.
  937. */
  938.    if ~open("fi", dest"/msg.last", "R") then do
  939.       address COMMAND "echo >"dest"/msg.last 1"
  940.       high = 0
  941.    end
  942.    else do
  943.       high = readln(fi)
  944.       close(fi)
  945.    end
  946.    high = high + 1
  947.  
  948.    address COMMAND "echo >"dest"/msg.last "high
  949. /*
  950. *   Header
  951. */
  952.    msg.0 = "=========="
  953.    msg.1 = "# "high", "date()", "time()", from "CurrentUser.Account". "
  954.    if comm ~= "" then msg.1 = msg.1 || "Comment to "comm"."
  955.    msg.2 = "----------"
  956.  
  957.    if ~open("fo", dest"/msg."high, "W") then do
  958.       say "Cannot add a message right now"
  959.       return
  960.    end
  961.  
  962.    do i = 0 to nlins
  963.       call writeln("fo", msg.i)
  964.    end
  965.  
  966.    call close("fo")
  967.    return
  968.  
  969.  
  970.  
  971. /**
  972. *
  973. *   Read mail messages.
  974. *   One argument: the message number to start reading. This resets the
  975. *   message pointer. This also allows you to skip to the last.
  976. *
  977. **/
  978. ReadMail: interpret "Procedure Expose" GLOBAL
  979.    parse arg nm
  980. /*
  981. *   If we have a message number for argument set user's message pointer
  982. *   to just before that.
  983. */
  984.    if nm ~= "" then CurrentUser.MailCount = nm - 1
  985. /*
  986. *   Unread mail
  987. */
  988.    source = BBSmail"/"CurrentUser.Account
  989.  
  990.    n = GetMsgLeft(source, CurrentUser.MailCount)
  991.    if n ~= 0 then say "You have "n" unread mail message"Esses(n)
  992.    else           CurrentUser.MailCount = GetHighMsg(source)
  993. /*
  994. *   Message read loop
  995. */
  996.    do i = 1 to n
  997.       do k = CurrentUser.MailCount + 1
  998.          if ~exists(source"/msg."k) then iterate k
  999.          address command "type "source"/msg."k
  1000.          CurrentUser.MailCount = k
  1001.  
  1002.          do j = 1
  1003.             s = upper(GetCommand("[Quit, Again, Delete, Reply, Next = <cr>]: ", 1))
  1004.             if      abbrev("QUIT",   s, 1) then return
  1005.             else if abbrev("AGAIN",  s, 1) then do
  1006.                CurrentUser.MailCount = k - 1
  1007.                i = i - 1
  1008.             end
  1009.             else if abbrev("DELETE", s, 1) then do
  1010.                call Delete(source"/msg."k)
  1011.                say "Deleted"
  1012.                CurrentUser.MailCount = k - 1
  1013.             end
  1014.             else if abbrev("REPLY",  s, 1) then do
  1015.                if open("fi", source"/msg."k) then do
  1016.                   call readln("fi")
  1017.                   t = readln("fi")
  1018.                   parse var t dummy "from " owner ". " rest
  1019.                   call close("fi")
  1020.                   call EnterMail(k, owner)
  1021.                end
  1022.             end
  1023.             else if abbrev("NEXT",   s, 1) then nop
  1024.             else if s = ""                 then nop
  1025.             else iterate j
  1026.             iterate i
  1027.          end
  1028.       end
  1029.    end
  1030.    say "No more unread messages"
  1031.    return
  1032.  
  1033.  
  1034.  
  1035. /**
  1036. *
  1037. *   Read messages.
  1038. *   Two arguments: (1) the message number to start reading. This resets the
  1039. *   message pointer. This also allows you to skip to the last. (2) The
  1040. *   source directory to read from.
  1041. *
  1042. **/
  1043. ReadMsg : interpret "Procedure Expose" GLOBAL
  1044.    parse arg nm
  1045. /*
  1046. *   If we have a message number for argument set user's message pointer
  1047. *   to just before that.
  1048. */
  1049.    if nm ~= "" then CurrentUser.MsgCount = nm - 1
  1050. /*
  1051. *   Unread regular messages
  1052. */
  1053.    source = BBSgeneral
  1054.  
  1055.    n = GetMsgLeft(source, CurrentUser.MsgCount)
  1056.    if n ~= 0 then say "You have "n" unread general message"Esses(n)
  1057.    else           CurrentUser.MsgCount = GetHighMsg(source)
  1058. /*
  1059. *   Message read loop
  1060. */
  1061.    do i = 1 to n
  1062.       do k = CurrentUser.MsgCount + 1
  1063.          if ~exists(source"/msg."k) then iterate k
  1064.          address command "type "source"/msg."k
  1065.          CurrentUser.MsgCount = k
  1066.  
  1067.          do j = 1
  1068.             s = upper(GetCommand("[Quit, Again, Delete, Comment, Next = <cr>]: ", 1))
  1069.  
  1070.             if      abbrev("QUIT",    s, 1) then return
  1071.             else if abbrev("AGAIN",   s, 1) then do
  1072.                CurrentUser.MsgCount = k - 1
  1073.                i = i - 1
  1074.             end
  1075.             else if abbrev("DELETE",  s, 1) then do
  1076.                if open("fi", source"/msg."k) then do
  1077.                   call readln("fi")
  1078.                   t = readln("fi")
  1079.                   parse var t dummy "from " owner ". " rest
  1080.                   call close("fi")
  1081.                   if owner = CurrentUser.Account then do
  1082.                      call Delete(source"/msg."k)
  1083.                      say "Deleted"
  1084.                   end
  1085.                   else do
  1086.                      say "You didn't write this message"
  1087.                      if CurrentUser.Access >= 5 then do
  1088.                         if GetYesNo("Withdraw anyway? ") = 1 then do
  1089.                            call Delete(source"/msg."k)
  1090.                            say "Deleted"
  1091.                         end
  1092.                      end
  1093.                   end
  1094.                end
  1095.             end
  1096.             else if abbrev("COMMENT", s, 1) then call EnterMsg(k, source)
  1097.             else if abbrev("NEXT",    s, 1) then nop
  1098.             else if s = ""                  then nop
  1099.             else                                 iterate j
  1100.             iterate i
  1101.          end
  1102.       end
  1103.    end
  1104.    say "No more unread messages"
  1105.    return
  1106.  
  1107.  
  1108.  
  1109. /**
  1110. *
  1111. *   Register a new user. The new user is immediately added to the
  1112. *   system, but his access code is 2 which doesn't allow her to
  1113. *   log in yet. The Sysop uses the Validate command to set the access
  1114. *   code to a higher level. 3 is suggested... 5 gives system privileges.
  1115. *
  1116. **/
  1117. Register: interpret "Procedure Expose" GLOBAL
  1118.    parse arg s
  1119. /*
  1120. *   If access = 0 this is a new user. If access = 5, this is called by
  1121. *   the Sysop.
  1122. */
  1123.    if CurrentUser.Access = 0 then prefix = "Your "
  1124.    else if CurrentUser.Access < 5 then do
  1125.       call HelpList(s)
  1126.       return
  1127.    end
  1128.    else prefix = "New "
  1129. /*
  1130. *   Generate registration record
  1131. */
  1132.    Tmp.Account   =       GetCommand(prefix"account name:         ", 1)
  1133.    if GetRecord() = 1 then do
  1134.       say "Account name already taken"
  1135.       return
  1136.    end
  1137. /*
  1138. *   Don't allow | characters in the password (security problem)
  1139. */
  1140.    do i = 1
  1141.       u = upper(GetCommand(prefix"password:             ", 0))
  1142.       if index(u, "|") ~= 0 then say "Illegal characters in password"
  1143.       else leave i
  1144.    end
  1145.  
  1146.    Tmp.Password  = u
  1147.    Tmp.Name      =       GetCommand(prefix"full name:            ", 1)
  1148.    Tmp.Address   =       GetCommand(prefix"address:              ", 1)
  1149.    Tmp.City      =       GetCommand(prefix"city, zip:            ", 1)
  1150.    Tmp.Country   =       GetCommand(prefix"country and/or state: ", 1)
  1151.    Tmp.Telephone =       GetCommand(prefix"telephone number:     ", 1)
  1152.    Tmp.Protocol  = 1
  1153.    Tmp.Access    = 2
  1154.    Tmp.MsgCount  = 0
  1155.    Tmp.MailCount = 0
  1156.  
  1157.    say "You are:"
  1158.    say Tmp.Name
  1159.    say Tmp.Address
  1160.    say Tmp.City
  1161.    say Tmp.Country
  1162.    say Tmp.Telephone
  1163.  
  1164.    if GetYesNo("Correct? ") = 1 then do
  1165.       call SetRecord()
  1166.  
  1167.       if CurrentUser.Access = 0 then do
  1168.          say "Please give the Sysop a chance to validate you (usually < 24 hours)."
  1169.          say "Thank you for registering with this BBS."
  1170.       end
  1171.    end
  1172.    return
  1173.  
  1174.  
  1175.  
  1176. /**
  1177. *
  1178. *   Change a user's record
  1179. *
  1180. **/
  1181. SetRecord: interpret "Procedure Expose" GLOBAL "Tmp."
  1182.    if Tmp.Access ~= 0 then do
  1183.       t = Tmp.Password  || '|' || Tmp.Access   || '|' ||,
  1184.           Tmp.Name      || '|' || Tmp.Address  || '|' ||,
  1185.           Tmp.City      || '|' || Tmp.Country  || '|' ||,
  1186.           Tmp.Telephone || '|' || Tmp.MsgCount || '|' ||,
  1187.           Tmp.MailCount || '|' || Tmp.Protocol || '|'
  1188.       if open("fo", BBSusers"/"Tmp.Account, "W") then do
  1189.          call writeln("fo", t)
  1190.          call close("fo")
  1191.       end
  1192.    end
  1193.    else call Delete(BBSusers'/'Tmp.Account)
  1194.    return
  1195.  
  1196.  
  1197.  
  1198. /**
  1199. *
  1200. *   Show a user's stats.
  1201. *
  1202. **/
  1203. ShowRecord: interpret "Procedure Expose" GLOBAL
  1204.    arg username
  1205.  
  1206.    if username = "" then Tmp.Account = CurrentUser.Account
  1207.    else                  Tmp.Account = username
  1208.    if GetRecord() = 1 then do
  1209.       say "Account info for "Tmp.Account":"
  1210.       say Tmp.Name
  1211.       say Tmp.Address
  1212.       say Tmp.City
  1213.       say Tmp.Country
  1214.       say Tmp.Telephone
  1215. /*
  1216. *   If asking about another user, don't need to show protocol.
  1217. *   If asking about ourselves, then show current protocol, not "saved" one.
  1218. */
  1219.       if username = "" then do
  1220.          i = CurrentUser.Protocol + 0
  1221.          say "Transfer protocol: "Protocols.i.nam
  1222.       end
  1223.    end
  1224.    else say "User "username" not found"
  1225.    return
  1226.  
  1227.  
  1228.  
  1229. /**
  1230. *
  1231. *   List files
  1232. *
  1233. **/
  1234. ShowUsers: interpret "Procedure Expose" GLOBAL
  1235.    address command "list "BBSusers" nohead quick"
  1236.    return
  1237.  
  1238.  
  1239.  
  1240. /**
  1241. *
  1242. *   Upload a new file
  1243. *
  1244. **/
  1245. UpLoad : interpret "Procedure Expose" GLOBAL
  1246.    parse arg filnam
  1247.  
  1248.    if filnam = "" then filnam = GetCommand("File name? ", 1)
  1249.    if exists(BBSlistings"/"filnam) then do
  1250.       say filnam" already exists!"
  1251.       return
  1252.    end
  1253.  
  1254.    say "Now send file "filnam
  1255.  
  1256.    proto = CurrentUser.Protocol + 0
  1257.    address VLT "transfer protocol external; transfer mode image"
  1258.    address VLT "xpr select "Protocols.proto.lib
  1259.    address VLT "CD "BBSlistings
  1260.    if Protocols.proto.set ~= "" then address VLT "xpr init "Protocols.proto.set
  1261.    address VLT "file receive "BBSlistings"/"filnam
  1262. /*
  1263. *   Switch back to XMODEM protocol so that we can't automatically start
  1264. *   receiving stuff.
  1265. */
  1266.    address VLT "transfer protocol XMODEM"
  1267.  
  1268.    return
  1269.  
  1270.  
  1271.  
  1272. /**
  1273. *
  1274. *   Routine to validate FifoBBS users. Only callable by the Sysop.
  1275. *
  1276. **/
  1277. Validate: interpret "Procedure Expose" GLOBAL
  1278.    parse arg s, nam, acc .
  1279.  
  1280.    if CurrentUser.Access < 5 then do
  1281.       call HelpList(s)
  1282.       return
  1283.    end
  1284.  
  1285.    if nam = "" then Tmp.Account = GetCommand("Name: ", 1)
  1286.    else             Tmp.Account = nam
  1287.  
  1288.    if GetRecord() = 0 then do
  1289.       say "Unknown account"
  1290.       return
  1291.    end
  1292.  
  1293.    if ~exists(BBSmail"/"Tmp.Account) then call Makedir(BBSmail"/"Tmp.Account)
  1294.  
  1295.    if acc = "" then do
  1296.       say "Account info for "Tmp.Account":"
  1297.       say Tmp.Name
  1298.       say Tmp.Address
  1299.       say Tmp.City
  1300.       say Tmp.Country
  1301.       say Tmp.Telephone
  1302.       say "Transfer protocol: "Tmp.Protocol
  1303.       say "Access code:       "Tmp.Access
  1304.  
  1305.       if GetYesNo("Change access code? ") = 1 then do
  1306.          Tmp.Access = GetCommand("Enter new access code: ", 1)
  1307.          call SetRecord()
  1308.       end
  1309.    end
  1310.    else do
  1311.       Tmp.Access = acc
  1312.       call SetRecord()
  1313.    end
  1314.    return
  1315.  
  1316.  
  1317.  
  1318.  
  1319.  
  1320. BREAK_C:
  1321. BREAK_D:
  1322. BREAK_E:
  1323. BREAK_F:
  1324. ERROR:
  1325. FAILURE:
  1326. HALT:
  1327. IOERROR:
  1328. NOVALUE:
  1329. SYNTAX:
  1330.    say "Command returned with error"
  1331.  
  1332.    interpret "SIGNAL" SignalLabel
  1333.  
  1334.    exit 0
  1335.